5 '			***** 	DIMS   *****
6 '
7 '
10 '				INITIALIZATION


20 DEFINT A-Z
30 GOSUB 3420 'cs
40 PRINT:PRINT TAB(31);"DIMS March 20, 1982
45			'ACT-5A TERMINAL
50 PRINT
80 '  Dan's Information Management System
85 '  for Basic-80 and CP/M
90 '  originates from PIMS written by Madan L. Gupta
95 '  which comes from A People's Data Base System
96 '  by Gupta and Brent Lander (1977)
100 ' re-written by Dan Dugan, 1979, 1980, 1981, 1982
110 ' Release 1.0 -- public domain
120 ' makes random disk records of 128 or 255 bytes
130 ' allows 15 or 30 data fields in record
140 ' makes automatic duplicate file
150 CLEAR,,1000 ' stack space for MBASIC 5.x
155 DEFINT A-Z
160 WIDTH LPRINT 255
170 ' init vars in this order for speed
180 I=0:J=0:K=0:X=0:Y=0:T$="":R$="":T1$="":SKIPPARSE=0:T=0:FT=0:SEARCH=0
190 ' then these for COMMON
200 C=0:N=0:NC=0:P6=0:P7=0:P8=0:P9=0:PI=0:S=0:T1=0:T2=0:F$="":FT$="":S$=""
210 DIM DD$(5)
220 DIM C$(10) ' commands
230 DIM N$(31), B$(32), C(30) ' 30 names + stop + N
240 DIM SEARCHWORD$(10), SEARCHFIELD(10), SKIPWORD$(10), LOOKFIELD(10)
243 NDRIVES=3:GOSUB 1360	' init disk name strings
245 PRINT TAB(33);NDRIVES"disk system.
250 GOTO 1050
1000 '


				WARM ENTRY


1010 DEFINT A-Z
1020 GOSUB 3420'cs
1023 IF C THEN GOSUB 1970	' save header
1025 IF T=7 THEN CLOSE:GOTO 1650		' goto
1030 IF T=8 THEN 4200		' reopen
1033 IF T=9 THEN CLOSE:T=0:GOTO 1050		' done
1035 IF T=11 THEN 2100		' backup
1040 IF T=12 THEN 3000		' renumber
1050 'some not needed but commoned to keep places for speed
1060 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,

	C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),

	SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
1070 ON ERROR GOTO 3290
1080 '



				NO-FILE MENU


1100 WIDTH 70 :RESET			'RESET here for floppy system
1105 IF E$<>"" THEN PRINT E$:PRINT
1110 PRINT:PRINT TAB(22)"Here are the data files on this disk:
1120 PRINT:FILES DD$(3)+"*.D?"
1125 WIDTH 255
1130 PRINT:PRINT:PRINT TAB(16);"*************  DIMS NO-FILE MENU  **************
1140 PRINT:PRINT TAB(16);"Open any data file shown above ............... 1
1150 PRINT TAB(16);"Install new disks ............................ 2
1160 PRINT
1170 PRINT TAB(16);"Design structure of a new file (DCREATE) ..... 3
1180 PRINT TAB(16);"Change number of disk drives for this session. 4
1190 PRINT
1200 PRINT TAB(16);"Exit DIMS to Basic ........................... 9
1210 PRINT TAB(16);"Exit DIMS to CP/M ............................ 0
1220 PRINT:PRINT TAB(16);STRING$(48,42):PRINT
1230 PRINT TAB(16);:

	PRINT"To continue enter a number ................... ";
1240 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="1"
1250 PRINT A$
1255 RESET		' safety for floppies
1260 IF A$="0" THEN SYSTEM
1270 IF A$="1" THEN GOTO 1650
1280 IF A$="2" THEN GOTO 1000
1290 IF A$="3" THEN CHAIN DD$(2)+"DCREATE"
1300 IF A$="4" THEN GOSUB 1330:GOTO 1000
1310 IF A$="9" THEN GOSUB 3420:STOP
1320 GOTO 1230
1330 '

				(SUB) ASK # DISKS


1340 PRINT:PRINT TAB(27);:INPUT"Number of disks in system";NDRIVES
1345 PRINT:IF NDRIVES<1 THEN 1000
1350 IF NDRIVES>4 THEN 1340
1360 '

		(SUB) INSTALL DISK NAMES


1370 RESTORE 1390
1380 '   DD$(1)  (2)  (3)  (4)  (5) ' file groups
1382 '     main trans data dupe misc
1383 '     pgms pgms  file file files
1390 DATA 1,"A:","A:","A:","A:","A:"
1400 DATA 2,"A:","B:","A:","B:","B:"
1410 DATA 3,"A:","A:","B:","C:","A:"
1420 DATA 4,"A:","A:","B:","C:","D:"
1430 READ J
1440 FOR K=1 TO 5
1450	READ DD$(K)
1460 NEXT
1470 IF J<>NDRIVES THEN 1430
1480 IF A$<>"4" THEN RETURN
1490 ON NDRIVES GOTO 1500,1510,1540,1580
1500 PRINT"One disk system - all files and programs on A.":GOTO 1630
1510 PRINT"Two disk system:  A: = main program and main data files
1520 PRINT TAB(19)"B: = transient programs, backup data files, aux. data files
1530 GOTO 1630
1540 PRINT

"Three disk system:  A: = main program, transient programs, aux data files
1550 PRINT TAB(21)"B: = main data files
1560 PRINT TAB(21)"C: = backup data files
1570 GOTO 1630
1580 PRINT"Four disk system:  A: = main and transient programs
1590 PRINT TAB(20)"B: = main data files
1600 PRINT TAB(20)"C: = backup data files
1610 PRINT TAB(20)"D: = aux. data files
1630 PRINT:PRINT TAB(29)"Hit return to continue.":A$=INPUT$(1)
1640 RETURN
1650 '



				LOAD HEADER


1660 GOSUB 3480 ' get name & open up files
1670 GOSUB 3420 'cs
1690 GOSUB 3750 ' get record
1700 GOSUB 1880 'parse into B$'s
1710 FOR I=1 TO 31
1720	N$(I)=B$(I) 'load names
1730	IF LEFT$(N$(I),4)="stop" GOTO 1760
1740	C(I)=1
1750 NEXT I
1760 N=VAL(B$(I+1))
1770 NC=I-1 ' # cols
1780 PRINT TAB(20)"File "F$" is open.  It has"N"records."
1790 '



				EXIT TO DEDIT


1795 PRINT:PRINT TAB(24)"Waiting while DEDIT is loading."
1800 CHAIN DD$(1)+"DEDIT",1000
1810 '



				(SUB) WRITE T$ AS RECORD # I


1820 ON FT GOTO 1850,1830
1830 LSET R$=MID$(T$,129) ' latter half
1840 PUT #1,FT*I+2
1850 LSET R$=LEFT$(T$,128) ' first half
1860 PUT #1,FT*I+1
1870 RETURN
1880 '




				(SUB) PARSE STRING


1890 K=0
1900 J=INSTR(T$,CHR$(126)) ' delimiter
1910 IF J=0 THEN RETURN
1920 K=K+1
1930 B$(K)=MID$(T$,1,J-1)
1940 T$=MID$(T$,J+1)
1950 GOTO 1900
1970 '


				(SUB) SAVE HEADERS


1990 PRINT:PRINT TAB(31)"Saving file header":PRINT TAB(39);
2000 T$=""
2010 FOR I=1 TO 31:

	T$=T$+N$(I)+CHR$(126):

	T1$=LEFT$(N$(I),4):

	IF T1$="stop" THEN 2030
2020 NEXT I
2030 T$=T$+STR$(N)+CHR$(126) 'add N at end
2040 I=0
2050 GOSUB 1810 ' put rec 0
2060 PRINT "*";
2062 NR=0:T1$=T$:GOSUB 3960	'put dupe head
2064 PRINT"!"
2070 RETURN
2100 '


				BACKUP makes dupe file


2110 CLOSE 2:KILL DD$(4)+F$+".DD"+FT$
2120 GOSUB 3720			' open up .DD on 2
2130 PRINT"Copying main file to dupe file, same numbers.":PRINT
2140 FOR I=0 TO N
2150	IF INKEY$=CHR$(27) THEN PRINT:PRINT:PRINT"Copy aborted.":GOTO 3260
2160	GOSUB 3750: PRINT"+";	' get record I in T$
2170	NR=I:T1$=T$:GOSUB 3960:PRINT"*"; ' put record NR
2180 NEXT
2190 PRINT:GOTO 3260			' to DEDIT
3000 '



				RENUMBER


		COPY MAIN TO DUPE


3010 CLOSE 2:KILL DD$(4)+F$+".DD"+FT$
3020 GOSUB 3720 ' open 2
3030 PRINT"Copying main file to dupe file, renumbering.":PRINT
3040 NR=0
3050 FOR I=1 TO N
3060	IF INKEY$=CHR$(27) THEN PRINT:PRINT:PRINT"Renumber aborted.":GOTO 3260
3070	GOSUB 3750 ' get rec I in T$
3080	IF ASC(T$)=0 THEN PRINT"0";:GOTO 3100' skip it
3090	PRINT"+";:NR=NR+1:T1$=T$:GOSUB 3960:PRINT"!"; ' put rec NR
3100 NEXT
3110 GOSUB 4030 ' save header (NR)
3120 '


		ERASE MAIN FILE AND COPY DUPE TO MAIN


3130 CLOSE
3140 PRINT:PRINT"The following operation removes space from deleted records:
3150 PRINT: PRINT"Erasing main file.
3160 KILL DD$(3)+F$+".D"+FT$
3170 PRINT:PRINT:PRINT"Copying dupe to main file.":PRINT
3180 GOSUB 3680 ' open both files
3190 FOR J=1 TO FT*(NR+1)
3200	GET #2,J
3210	PRINT"&";
3220	LSET R$=S$
3230	PUT #1,J
3240	PRINT"*";
3250 NEXT J
3251 N=NR
3252 PRINT:GOSUB 1970			'put header
3255 '


		RETURN TO DEDIT
3260 GOTO 1790
3280 '


				GENERAL ERROR ROUTINES


3290 IF ERL=1120 AND ERR=53 THEN RESUME 1130 ' if disk empty
3300 IF ERL=1740 AND ERR=9

	THEN CLOSE:E$="CAN'T READ HEADER PROPERLY":RESUME 1000
3310 IF ERR=61 THEN PRINT:PRINT"Out of disk space.":PRINT:CLOSE:RESUME 1000
3312 IF ERR=53 THEN E$="FILE NOT FOUND":RESUME 1080
3320 ON ERROR GOTO 0
3330 '



				UCV


3340 Y$=""
3350 FOR K=1 TO LEN(X$)
3360	Y$=Y$+" "
3370	X=ASC(MID$(X$,K, 1))
3380	IF 96<X AND X<123 THEN MID$(Y$,K,1)=CHR$(X-32): GOTO 3400
3390	MID$(Y$,K,1)=MID$(X$,K,1)
3400 NEXT
3410 RETURN
3420 '



				(SUB) CLEAR SCREEN (TERM DEP)


3430 PRINT CHR$(12);
3440 RETURN
3480 '



				(SUB) OPEN UP FILES

		GET NAME


3490 F$=""
3500 C=0 ' clear change flag
3505 IF T=7 THEN F$=B$(0):T=0:GOTO 3525	' goto commmand
3510 PRINT: PRINT TAB(17);: INPUT"Name of the file you want to open"; F$
3525 IF F$="" THEN 1000
3530 X$=F$
3540 GOSUB 3330 ' UCverter
3550 F$=Y$ ' make UC
3560 '


		TEST NAME, EXTRACT FILE TYPE


3570 CLOSE
3580 ON ERROR GOTO 3610
3590 OPEN"I",1,DD$(3)+F$+".D"
3600 FT=1: FT$=" ": GOTO 3690 ' file is type 1
3610	IF ERR=64 THEN 3612 ELSE 3620
3612		E$="BAD FILE NAME":PRINT E$:IF T=7 THEN T=0:RESUME 1000
3614		RESUME 3480
3620	IF ERR=53 THEN CLOSE:RESUME 3630'not found
3630 ON ERROR GOTO 3660
3640 OPEN"I",1,DD$(3)+F$+".D2"
3650 FT=2: FT$="2": GOTO 3690 ' file is type 2
3660	IF ERR=53 THEN 3662 ELSE 3670
3662		E$="FILE NOT FOUND":PRINT E$:IF T=7 THEN T=0:RESUME 1000
3664		RESUME 3480
3670	ON ERROR GOTO 0
3680 '


		OPEN UP FILES FOR REAL


3690 CLOSE:I=0:ON ERROR GOTO 3280
3700 OPEN "R",1,DD$(3)+F$+".D"+FT$
3710 FIELD #1,128 AS R$
3720 OPEN "R",2,DD$(4)+F$+".DD"+FT$
3730 FIELD #2, 128 AS S$
3740 RETURN
3750 '


				(SUB) GET REC. I IN T$


3760 T$=""
3770 ON FT GOTO 3800,3780
3780	GET#1,FT*I+2 ' latter half
3790	T$=LEFT$(R$,127)
3800	GET#1,FT*I+1 ' whole or first half
3810	T$=R$+T$
3820 RETURN
3830 '


				(SUB) SHOW FIELDS


3840 FOR J=1 TO NC
3850	IF C(J)=0 THEN 3880
3860	PRINT TAB(29);
3870	PRINT USING"##";J;:PRINT".  "LEFT$(N$(J),4)"  "RIGHT$(N$(J),1)
3880 NEXT
3890 PRINT
3900 RETURN
3960 '


				(SUB) PUT T1$ AS REC NR


3970 ON FT GOTO 4000,3980
3980	LSET S$=MID$(T1$,129)
3990	PUT#2,FT*NR+2
4000	LSET S$=LEFT$(T1$,128)
4010	PUT#2,FT*NR+1
4020 RETURN
4030 '


				(SUB) CLOSE DUPE FILE


4040 IF F2$=F$ THEN C=1:N=NR:GOTO 4130
4050 PRINT:PRINT:PRINT"Closing dupe file,"NR"records.
4060 T$=""
4070 FOR I=1 TO 31
4080	T$=T$+N$(I)+CHR$(126)
4090	IF LEFT$(N$(I),4)="stop" THEN 4110
4100 NEXT
4110 T1$=T$+STR$(NR)+CHR$(126)
4120 N1=NR:NR=0:GOSUB 3960:NR=N1
4130 CLOSE 2
4140 RETURN
4200 '


				RE-OPEN AFTER DISK ERR


4210 CLOSE:GOSUB 3700:GOTO 1790
